home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tppcx.zip / RUNPCX.PAS < prev    next >
Pascal/Delphi Source File  |  1991-01-29  |  2KB  |  70 lines
  1. { sample program to show PCX file }
  2. program RunPCX;
  3. uses Crt, Dos, Graph, PCX, EGA;
  4.  
  5. const
  6.   Page0 = 0;
  7.  
  8. var
  9.   p: BasePCXPtr;
  10.   OldExitProc: pointer;
  11.   eStr: string;
  12.   Fname: PathStr;
  13.   Dir: DirStr;
  14.   Name: NameStr;
  15.   Ext: ExtStr;
  16.  
  17. {$F+} procedure NewExitProc; {$F-}
  18. begin ExitProc:= OldExitProc; CloseGraph; end;
  19.  
  20. procedure InitBGI;
  21. var Path: string;
  22.   Error, Driver, Mode: integer;
  23. begin
  24.   DirectVideo := false;
  25.   OldExitProc := ExitProc;
  26.   ExitProc := @NewExitProc;
  27.   Path := '\tp\bgi';
  28.   repeat
  29.     Driver := Detect;
  30.     InitGraph( Driver, Mode, path );
  31.     Error := GraphResult;
  32.     if ( Error <> grOK ) then begin
  33.         Writeln( 'Graphics ERROR ', GraphErrorMsg( Error ) );
  34.         if ( Error = grFileNotFound ) then begin
  35.           Write( 'Enter path to graphics driver: ');
  36.           Readln( Path );
  37.           end;
  38.         end;
  39.   until Error = grOK;
  40. end;
  41.  
  42. procedure ShowUsage;
  43. begin
  44.   writeln;
  45.   writeln( 'USAGE: RunPCX <filename>' );
  46.   writeln;
  47.   Halt(0);
  48. end;
  49.  
  50. begin
  51.   if ParamCount < 1 then ShowUsage
  52.     else Fname := FExpand( ParamStr( 1 ));
  53.   FSplit( Fname, Dir, Name, Ext );
  54.   if Ext <> '.PCX' then Fname := Fname + '.PCX';
  55.   InitBGI;
  56.   if VGACard then p := New( VgaPCXPtr, Init )
  57.     else if EGACard then p := New( EgaPCXPtr, Init )
  58.       else p := New( HercPCXPtr, Init );
  59.   if p = NIL then Halt;
  60.   p^.Show( Fname, page0, true );
  61.    if p^.GetPCXError <> PCXError0 then begin
  62.     Str( p^.GetPCXError, eStr );
  63.     OutText( 'PCX unit error #' + eStr );
  64.     end;
  65.   repeat until KeyPressed;
  66. {  P^.Save( 50, 50, 300, 250, 'test.pcx' ); }
  67.   Dispose( p, Done );
  68.   EGA_ResetPalette;
  69. end.
  70.